﻿(*   Copyright 2011 Alexander Omelchuk
 *
 *   Licensed under the Apache License, Version 2.0 (the "License");
 *   you may not use this file except in compliance with the License.
 *   You may obtain a copy of the License at
 *
 *       http://www.apache.org/licenses/LICENSE-2.0
 *
 *   Unless required by applicable law or agreed to in writing, software
 *   distributed under the License is distributed on an "AS IS" BASIS,
 *   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 *   See the License for the specific language governing permissions and
 *   limitations under the License.
 *)

namespace Lisp
open System.Linq.Expressions
open System.Reflection

module Eval =
  let mutable dEnv = Expression.Parameter(typeof<IDynamicEnvironment>)
  let mutable lEnv = new LEnvironment(None, None)

  let dEnvConstructor = typeof<DEnvironment>.GetConstructor([| typeof<IDynamicEnvironment> |])
  let NilConstant = Expression.Constant(Nil, typeof<SExpr>) :> Expression
  let exprEquals = 
    let equals = typeof<SExpr>.GetMethod("Equals", [|typeof<SExpr>|])
    fun (expr1:Expression) (expr2:Expression) ->
      Expression.Call(expr1, equals, [| expr2 |]) :> Expression
  let IsNil (x:Expression) =
    // x :? Id  && (x :> Id).Name = kwNil
    Expression.AndAlso(
      Expression.TypeIs(x, typeof<Id>),
      Expression.Equal(
        Expression.Field(Expression.Convert(x, typeof<Id>), "Name@"),
        Expression.Constant(kwNil)))

  let doInDynamic body () =
    let oldDEnv = dEnv
    try 
      // establish new dynamical environment on top of existing one
      dEnv <- Expression.Variable(typeof<IDynamicEnvironment>)      
      // in generated code, create new dynamical environment
      Expression.Block(
        [| dEnv |],
        seq {
          yield Expression.Assign(
            dEnv :> Expression,
            Expression.New(dEnvConstructor, [| oldDEnv :> Expression |])) :>Expression
          yield! body ()
        }) :> Expression
    finally
      // disestablish new dynamical environment
      dEnv <- oldDEnv    

  let doInLexical newEnv action =
    // dynamical environment will be remembered and restored
    let oldLEnv, oldDEnv = lEnv, dEnv
    lEnv <- newEnv
    try 
      action()
    finally
      lEnv <- oldLEnv
      dEnv <- oldDEnv    
  
  let dynamicVar =
    let varsProperty = typeof<IDynamicEnvironment>.GetProperty("Item")
    fun name ->
      Expression.Property(
        dEnv, varsProperty,
        [| Expression.Constant(name, typeof<string>):>Expression|])
      :> Expression

  let getVar name = defaultArg (lEnv.GetVar name) (dynamicVar name)

  ///<summary>Translate s-expression to linq expression.</summary>
  let rec eval = function
  | Id x -> getVar x
  | Lst (Id op, args) ->
    try match lEnv.GetFunction op with
        | Some (SpecialOp lambda) -> lambda args
        | Some (Macro (lambdaList, func)) ->
          let args = args |> Lst.toSeq |> Seq.toArray
                     |> lambdaList.ToFuncArgs (GEnvironment.Instance :> obj)
                     |> Seq.toArray
          eval (func.DynamicInvoke(args))
        | Some (Function (lambdaList, expr)) ->
          let args = mapSeq eval args |> Seq.toArray
                     |> lambdaList.ToFuncArgs (dEnv:>Expression)
          Expression.Invoke(expr, args) :> Expression
        | None ->
          let args = Expression.NewArrayInit(typeof<SExpr>, mapSeq eval args) :> Expression
          Expression.Call(
            typeof<GEnvironment>.GetMethod("Apply"),
            [|Expression.Constant(op) :> Expression; dEnv:>Expression; args|]) :> Expression
          
    with | exc ->
           let exc = match exc with
                     | :? TargetInvocationException as x -> x.InnerException
                     | _ -> exc
           match exc with
           | FuncException(msg) -> raiseError (System.String.Format(msg, op))
           | _ -> raise exc
  | Lst(notFun,_) -> raiseExprError isNotFun notFun
  | x -> Expression.Constant(x, typeof<SExpr>) :> Expression

  and progn (expr:SExpr) =
    match expr with
    | Lst _ as x -> let body = mapSeq eval x
                    if Seq.isEmpty body then NilConstant
                    else Expression.Block(body) :> Expression
    | _ -> NilConstant

  let compile' eval' expr =
    Expression.Lambda<System.Func<IDynamicEnvironment, SExpr>>(
      eval' expr, [| dEnv |])

  let compile expr = compile' progn expr

  let compileOne expr = compile' eval expr
    
  let evalInLexical newEnv expr = doInLexical newEnv (fun () -> eval expr)